home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / e / amigae30a_fr.lha / AmigaE30f / Sources / Game / Race.e
Encoding:
Text File  |  1994-12-02  |  8.1 KB  |  303 lines
  1. /* version ordinateur du jeu autorace
  2.  
  3.    Jouez juste pour voir comment il marche. L'objectif est
  4.    de bien choisir sa vitesse pour allez rapidement sans rentrer
  5.    chez les autres. Si vous conduisez trop vite pour prendre un
  6.    virage, vous perdez. Ce jeu est facile aussi à jouer sur le
  7.    papier. A part le fait que vous pouvez dessiner de belles
  8.    courbes avec :-)
  9.  
  10. */
  11.  
  12. OPT OSVERSION=37
  13.  
  14. MODULE 'tools/clonescreen', 'gadtools', 'libraries/gadtools',
  15.        'intuition/screens', 'graphics/text', 'intuition/intuition',
  16.        'graphics/rastport'
  17.  
  18. CONST MAXP=10,
  19.       MAXBOUND=1000,
  20.       MAXTRAS=50000,
  21.       OFF=7
  22. CONST MAXAREA=MAXBOUND*5+10,
  23.       OURIDCMP=IDCMP_MENUPICK+IDCMP_MOUSEMOVE+IDCMP_MOUSEBUTTONS
  24.  
  25. DEF xres=60,yres=40,xpixel,ypixel,xoff=20,yoff,xsize,ysize,window=NIL,
  26.     curx[MAXP]:LIST, cury[MAXP]:LIST, lastx[MAXP]:LIST, lasty[MAXP]:LIST,
  27.     players=2,curp,stat,midx,midy,pointx,pointy,p[18]:LIST,
  28.     kx1,kx2,ky1,ky2,boundary[MAXBOUND]:LIST,area[MAXAREA]:ARRAY,
  29.     ainfo:areainfo,tras:tmpras,nogreen=FALSE
  30.  
  31. PROC main()
  32.   DEF screen=NIL:PTR TO screen,font=NIL:PTR TO textfont,depth,title,menu,visual
  33.   title:='AutoRace v0.1'
  34.   IF gadtoolsbase:=OpenLibrary('gadtools.library',37)
  35.     screen,window,font:=openscreenwindow(title)
  36.     IF screen
  37.       font:=Long(stdrast+52)
  38.       depth,xsize,ysize:=getcloneinfo(screen)
  39.       yoff:=screen.wbortop+font.ysize+1+30
  40.       xpixel:=xsize-10-xoff/xres
  41.       ypixel:=ysize-10-yoff/yres
  42.       SetColour(screen,0,$04,$C2,$73)
  43.       SetColour(screen,1,$00,$00,$00)
  44.       SetColour(screen,2,$DF,$DF,$DF)
  45.       SetColour(screen,3,$E1,$5A,$03)
  46.       IF window
  47.         Colour(3,2)
  48.         TextF(10,20,'\d \d',xpixel,ypixel)
  49.         IF menu:=CreateMenusA([1,0,'Projet',0,0,0,0,
  50.                                  2,0,'Nouveau','n',0,0,0,
  51.                                  2,0,'Pas de vert','g',0,0,0,
  52.                                  2,0,'Quitter','q',0,0,0,
  53.                                1,0,'Joueur',0,0,0,0,
  54.                                  2,0,'Un','1',0,0,0,
  55.                                  2,0,'Deux','2',0,0,0,
  56.                                  2,0,'Trois','3',0,0,0,
  57.                                  2,0,'Quatre','4',0,0,0,
  58.                                  2,0,'Cinq','5',0,0,0,
  59.                                0,0,0,0,0,0,0]:newmenu,NIL)
  60.           IF visual:=GetVisualInfoA(screen,NIL)
  61.             IF LayoutMenusA(menu,visual,NIL)
  62.               IF SetMenuStrip(window,menu)
  63.                 loop()
  64.                 ClearMenuStrip(window)
  65.               ELSE
  66.                 WriteF('Ne peut pas mettre le menu!\n')
  67.               ENDIF
  68.             ELSE
  69.               WriteF('Ne peut pas mettre en place les menus!\n')
  70.             ENDIF
  71.             FreeVisualInfo(visual)
  72.           ELSE
  73.             WriteF('ne peut pas prendre les visual infos!\n')
  74.           ENDIF
  75.           FreeMenus(menu)
  76.         ELSE
  77.           WriteF('Ne peut pas créer les menus!\n')
  78.         ENDIF
  79.       ELSE
  80.         WriteF('Ne peut pas ouvrir de fenêtre!\n')
  81.       ENDIF
  82.     ELSE
  83.       WriteF('Ne peut pas ouvrir d\aécran!\n')
  84.     ENDIF
  85.     closeclonescreen(screen,font,window)
  86.     CloseLibrary(gadtoolsbase)
  87.   ELSE
  88.     WriteF('ne peut ouvrir la gadtools v37+\n')
  89.   ENDIF
  90. ENDPROC
  91.  
  92. PROC openscreenwindow(t) HANDLE
  93.   DEF s=NIL,w=NIL,f=NIL
  94.   s,f:=openclonescreen('Workbench',t,3)
  95.   w:=backdropwindow(s,OURIDCMP,$1B00)
  96. EXCEPT
  97. ENDPROC s,w,f
  98.  
  99.  
  100. PROC wait4message(window:PTR TO window)
  101.   DEF mes:PTR TO intuimessage,type,infos
  102.   REPEAT
  103.     type:=0
  104.     IF mes:=Gt_GetIMsg(window.userport)
  105.       type:=mes.class
  106.       IF type=IDCMP_MENUPICK
  107.         infos:=mes.code
  108.         IF infos=-1 THEN type:=0
  109.       ELSEIF type=IDCMP_MOUSEBUTTONS
  110.         IF mes.code<>SELECTUP THEN type:=0
  111.       ELSEIF type=IDCMP_REFRESHWINDOW
  112.         Gt_BeginRefresh(window)
  113.         Gt_EndRefresh(window,TRUE)
  114.         type:=0
  115.       ENDIF
  116.       Gt_ReplyIMsg(mes)
  117.     ELSE
  118.       Wait(-1)
  119.     ENDIF
  120.   UNTIL type
  121. ENDPROC type,infos
  122.  
  123. ENUM NO_ACTION,SELECTING,GAME_OVER   -> stat
  124. CONST BACKC=2,FRONTC=1,PLAYERC=3,GRASSC=0
  125.  
  126. PROC loop() HANDLE
  127.   DEF quit=FALSE,class,infos,menu,item,rast:PTR TO rastport
  128.   ListCopy(boundary,[11,7, 24,5, 42,10, 45,16, 43,26, 39,29, 25,33, 10,30, 7,23, 6,17, 11,7])
  129.  
  130.   rast:=stdrast
  131.   rast.aolpen:=GRASSC
  132.   ->rast.flags:=rast.flags OR RPF_AREAOUTLINE
  133.   rast.tmpras:=InitTmpRas(tras,NewM(MAXTRAS,2),MAXTRAS)
  134.   InitArea(ainfo,area,MAXAREA)
  135.   rast.areainfo:=ainfo
  136.  
  137.   resetgame()
  138.   REPEAT
  139.     IF stat=NO_ACTION THEN startselection()
  140.     class,infos:=wait4message(window)  ->WaitIMessage(window) -> planté?
  141.     SELECT class
  142.       CASE IDCMP_MENUPICK
  143.         menu:=infos AND %11111
  144.         item:=Shr(infos AND %11111100000,5)
  145.         SELECT menu
  146.           CASE 0
  147.             SELECT item
  148.               CASE 0; nogreen:=FALSE; resetgame()
  149.               CASE 1; nogreen:=TRUE;  resetgame()
  150.               CASE 2; quit:=TRUE
  151.             ENDSELECT
  152.           CASE 1
  153.             players:=item+1
  154.             resetgame()
  155.         ENDSELECT
  156.       CASE IDCMP_MOUSEMOVE
  157.         IF stat<GAME_OVER THEN updateselection()
  158.       CASE IDCMP_MOUSEBUTTONS
  159.         IF stat<GAME_OVER THEN finishselection()
  160.     ENDSELECT
  161.   UNTIL quit
  162. EXCEPT
  163.   WriteF('Pas de mémoire pour tmpras!\n')
  164. ENDPROC
  165.  
  166. PROC resetgame()
  167.   DEF x,y,a,l
  168.   Box(0,0,xsize-1,ysize-1,BACKC)
  169.   FOR x:=0 TO xres DO FOR y:=0 TO yres DO vplot(x,y,FRONTC)
  170.   Line(xcoord(0),ycoord(0),xcoord(15),ycoord(15),FRONTC)
  171.   Colour(GRASSC,BACKC)
  172.   IF nogreen=FALSE
  173.     AreaMove(stdrast,xcoord(boundary[0]),ycoord(boundary[1]))
  174.     l:=ListLen(boundary)
  175.     FOR a:=2 TO l-1 STEP 2 DO AreaDraw(stdrast,xcoord(boundary[a]),ycoord(boundary[a+1]))
  176.     AreaEnd(stdrast)
  177.   ENDIF
  178.   FOR a:=0 TO players-1
  179.     curx[a]:=OFF-a; cury[a]:=OFF-a; lastx[a]:=OFF-a; lasty[a]:=OFF-a
  180.   ENDFOR
  181.   stat:=NO_ACTION
  182.   curp:=0
  183. ENDPROC
  184.  
  185. PROC startselection()
  186.   DEF posm=0,a,b,pc:PTR TO LONG,distx,disty,x,y
  187.   midx:=curx[curp]-lastx[curp]+curx[curp]
  188.   midy:=cury[curp]-lasty[curp]+cury[curp]
  189.   pc:=p
  190.   stat:=SELECTING
  191.   FOR a:=-1 TO 1
  192.     FOR b:=-1 TO 1
  193.       IF valid(midx+a,midy+b)
  194.         posm++
  195.         pc[]++:=xcoord(midx+a)
  196.         pc[]++:=ycoord(midy+b)
  197.       ELSE
  198.         pc[]++:=0
  199.         pc[]++:=0
  200.       ENDIF
  201.     ENDFOR
  202.   ENDFOR
  203.   IF posm
  204.     message('Joueur \d a \d déplacement(s) possible(s)',curp+1,posm)
  205.     plotplayer(curp)
  206.     x:=xcoord(midx); y:=ycoord(midy)
  207.     distx:=xpixel/2+xpixel
  208.     disty:=ypixel/2+ypixel
  209.     kx1:=x-distx
  210.     kx2:=x+distx
  211.     ky1:=y-disty
  212.     ky2:=y+disty
  213.     drawkader()
  214.     computemouse()
  215.     selectline(2)
  216.   ELSE
  217.     message('Joueur \d a perdu!',curp+1,0)
  218.     stat:=GAME_OVER
  219.   ENDIF
  220. ENDPROC
  221.  
  222. PROC updateselection()
  223.   selectline(2)
  224.   computemouse()
  225.   selectline(2)
  226. ENDPROC
  227.  
  228. PROC finishselection()
  229.   selectline(2)
  230.   drawkader()
  231.   selectline(1)
  232.   vplot(curx[curp],cury[curp],FRONTC)
  233.   lastx[curp]:=curx[curp]
  234.   lasty[curp]:=cury[curp]
  235.   curx[curp]:=xvirtua(pointx)
  236.   cury[curp]:=yvirtua(pointy)
  237.   stat:=NO_ACTION
  238.   curp++
  239.   IF curp=players THEN curp:=0
  240.   plotplayer(curp)
  241. ENDPROC
  242.  
  243. PROC computemouse()
  244.   DEF pc:PTR TO LONG,a,x,y,mx,my
  245.   pc:=p
  246.   pointx:=pointy:=10000
  247.   mx:=MouseX(window)
  248.   my:=MouseY(window)
  249.   FOR a:=0 TO 8
  250.     x:=pc[]++; y:=pc[]++
  251.     IF x
  252.       IF (Abs(x-mx)+Abs(y-my))<(Abs(pointx-mx)+Abs(pointy-my))
  253.         pointx:=x; pointy:=y
  254.       ENDIF
  255.     ENDIF
  256.   ENDFOR
  257.   IF (pointx=10000) OR (pointy=10000)
  258.     pointx:=0
  259.     pointy:=0
  260.   ENDIF
  261. ENDPROC
  262.  
  263. PROC selectline(mode)
  264.   SetDrMd(stdrast,mode)
  265.   Line(xcoord(curx[curp]),ycoord(cury[curp]),pointx,pointy,FRONTC)
  266.   SetDrMd(stdrast,1)
  267. ENDPROC
  268.  
  269. PROC xcoord(vx) RETURN vx*xpixel+xoff
  270. PROC ycoord(vy) RETURN vy*ypixel+yoff
  271. PROC col(vx,vy) RETURN ReadPixel(stdrast,xcoord(vx),ycoord(vy))
  272. PROC valid(x,y) RETURN col(x,y)=FRONTC
  273. PROC xvirtua(x) RETURN x-xoff/xpixel
  274. PROC yvirtua(y) RETURN y-yoff/ypixel
  275.  
  276. PROC drawkader()
  277.   SetDrMd(stdrast,2)
  278.   Line(kx1,ky1,kx1,ky2,FRONTC)
  279.   Line(kx1,ky1,kx2,ky1,FRONTC)
  280.   Line(kx2,ky2,kx1,ky2,FRONTC)
  281.   Line(kx2,ky2,kx2,ky1,FRONTC)
  282.   SetDrMd(stdrast,1)
  283. ENDPROC
  284.  
  285. PROC vplot(vx,vy,col)
  286.   DEF x,y
  287.   x:=xcoord(vx)
  288.   y:=ycoord(vy)
  289.   Box(x,y,x+1,y+1,col)
  290. ENDPROC
  291.  
  292. PROC plotplayer(player)
  293.   DEF x,y
  294.   x:=xcoord(curx[player])
  295.   y:=ycoord(cury[player])
  296.   Box(x-1,y-1,x+2,y+2,PLAYERC+player)
  297. ENDPROC
  298.  
  299. PROC message(s,p1,p2)
  300.   TextF(10,30,'                                             ')
  301.   TextF(10,30,s,p1,p2)
  302. ENDPROC
  303.